;  auteur vincentp010 
;  suite à ces messages
;  http://cadxp.com/topic/39027-extraction-wkt/page__view__findpost__p__216626
;  Faire une sélection et vérifier dans les propriété qu'il n'y a pas de polylign2D
;  s'il y en à, utiliser la fonction CONVERTPOLY pour les transformer en polylignes


(defun c:wkt (/ ss ent f1 f nb lspl pl c strcoords strdelim)
  (vl-load-com)

  (print "Selectionnez les polylignes")
  (setq ss (cadr (sssetfirst nil (ssget (list (cons 0 "LWPOLYLINE"))))))
  (if (/= ss nil) (progn
    (setq f1 (getfiled "Fichier wtk a creer" "" "wkt" 1))
    (if (/= f1 nil) (progn
      (setq f (open f1 "w"))
      (write-line "Calque|Type de ligne|Couleur|Epaisseur|Largeur|Geometrie" f)
      (setq nb 0 lspl nil)
      (while (< nb (sslength ss))
        (setq ent (vlax-ename->vla-object (ssname ss nb)))
        (setq pl (list 
          (strcat (vla-get-layer ent)"|" (vla-get-LineType ent) "|" (rtos(vla-get-color ent)) "|" (rtos (vla-get-LineWeight ent)) "|" (rtos (vla-get-ConstantWidth ent) 2)) 
          (vlax-safearray->list (vlax-variant-value (vla-get-coordinates ent)))
        ))
        (setq lspl (append lspl (list pl)))
        (setq nb (+ nb 1))
      );_end while
      ;ordre croissant suivant premiere entite
      (setq lspl (vl-sort lspl
        (function (lambda (e1 e2) (< (car e1) (car e2))))
      ))
      (foreach pl lspl
        (setq strcoords "(")
        (setq strdelim "")
        (foreach c (nth 1 pl)
          (setq strcoords (strcat strcoords strdelim (rtos c 2)))
          (if (= strdelim " ")
            (setq strdelim ",")
            (setq strdelim " ")
          )
        );_end foreach
        (write-line (strcat (nth 0 pl) "|LINESTRING" strcoords ")") f)
      );_end foreach
      (close f)
      (print (strcat "Fichier " f1 " cree"))
      (print)
    ));_end f1 nil
  ));_end ss nil

)